home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / perlcl16.lha / perlclass1.6 / perlclass.c++ < prev    next >
C/C++ Source or Header  |  1992-11-10  |  13KB  |  560 lines
  1. /*
  2.  * Version 1.6
  3.  * Written by Jim Morris,  jegm@sgi.com
  4.  * Kudos to Larry Wall for inventing Perl
  5.  * Copyrights only exist on the regex stuff,  and all
  6.  * have been left intact.
  7.  * The only thing I ask is that you let me know of any nifty fixes or
  8.  * additions.
  9.  * Credits:
  10.  * I'd like to thank Michael Golan <mg@Princeton.EDU> for his critiques
  11.  * and clever suggestions. Some of which have actually been implemented
  12.  */
  13. #include <iostream.h>
  14. #include <string.h>
  15. #include <malloc.h>
  16. #include <stdio.h>
  17.  
  18. #ifdef    __TURBOC__
  19. #pragma hdrstop
  20. #endif
  21.  
  22. #include "perlclass.h"
  23.  
  24. // VarString Implementation
  25. VarString& VarString::operator=(const char *s)
  26. {
  27.     int nl= strlen(s);
  28.     if(nl+1 >= allocated) grow((nl-allocated)+allocinc);
  29.     assert(allocated > nl+1);
  30.     strcpy(a, s);
  31.     len= nl;
  32.     return *this;
  33. }
  34.  
  35. VarString& VarString::operator=(const VarString& n)
  36. {
  37.     if(this != &n){
  38.     if(n.len+1 >= allocated){ // if it is not big enough
  39. #        ifdef    DEBUG
  40.         fprintf(stderr, "~operator=(VarString&) a= %p\n", a);
  41. #        endif
  42.         delete [] a; // get rid of old one
  43.         allocated= n.allocated;
  44.         allocinc= n.allocinc;
  45.         a= new char[allocated];
  46. #        ifdef    DEBUG
  47.         fprintf(stderr, "operator=(VarString&) a= %p, source= %p\n", a, n.a);
  48. #        endif
  49.     }
  50.         len= n.len;
  51.     strcpy(a, n.a);
  52.     }
  53.     return *this;
  54. }
  55.  
  56. void VarString::grow(int n)
  57. {
  58.     if(n == 0) n= allocinc;
  59.     allocated += n;
  60.     char *tmp= new char[allocated];
  61.     strcpy(tmp, a);
  62. #ifdef    DEBUG
  63.     fprintf(stderr, "VarString::grow() a= %p, old= %p, allocinc= %d\n", tmp, a, allocinc);
  64.     fprintf(stderr, "~VarString::grow() a= %p\n", a);
  65. #endif
  66.     delete [] a;
  67.     a= tmp;
  68. }
  69.  
  70. void VarString::add(char c)
  71. {
  72.     if(len+1 >= allocated) grow();
  73.     assert(allocated > len+1);
  74.     a[len++]= c; a[len]= '\0';
  75. }
  76.  
  77. void VarString::add(const char *s)
  78. {
  79.     int nl= strlen(s);
  80.     if(len+nl >= allocated) grow(((len+nl)-allocated)+allocinc);
  81.     assert(allocated > len+nl);
  82.     strcat(a, s);
  83.     len+=nl;
  84. }
  85.  
  86. void VarString::add(int ip, const char *s)
  87. {
  88.     int nl= strlen(s);
  89.     if(len+nl >= allocated) grow(((len+nl)-allocated)+allocinc);
  90.     assert(allocated > len+nl);
  91.     memmove(&a[ip+nl], &a[ip], (len-ip)+1); // shuffle up
  92.     memcpy(&a[ip], s, nl);
  93.     len+=nl;
  94.     assert(a[len] == '\0');
  95. }
  96.  
  97. void VarString::remove(int ip, int n)
  98. {
  99.     assert(ip+n <= len);
  100.     memmove(&a[ip], &a[ip+n], len-ip); // shuffle down
  101.     len-=n;
  102.     assert(a[len] == '\0');    
  103. }
  104.  
  105. //
  106. // PerlString stuff
  107. //
  108.  
  109. // assignments
  110. PerlString& PerlString::operator=(const PerlString& n)
  111. {
  112.     if(this == &n) return *this;
  113.     pstr= n.pstr;
  114.     return *this;
  115. }
  116.  
  117. PerlString& PerlString::operator=(const substring& sb)
  118. {
  119.     VarString tmp(sb.pt, sb.len);
  120.     pstr= tmp;
  121.     return *this;
  122. }
  123.  
  124. // concatenations
  125. PerlString PerlString::operator+(const PerlString& s) const
  126. {
  127.     PerlString ts(*this);
  128.     ts.pstr.add(s);    
  129.     return ts; 
  130. }
  131.  
  132. PerlString PerlString::operator+(const char *s) const
  133. {
  134.     PerlString ts(*this);
  135.     ts.pstr.add(s);
  136.     return ts; 
  137. }
  138.  
  139. PerlString PerlString::operator+(char c) const
  140. {
  141.     PerlString ts(*this);
  142.     ts.pstr.add(c);
  143.     return ts; 
  144. }
  145.  
  146. PerlString operator+(const char *s1, const PerlString& s2)
  147. {
  148.     PerlString ts(s1);
  149.     ts = ts + s2;
  150. //    cout << "s2[0] = " << s2[0] << endl; // gives incorrect error
  151.     return ts; 
  152. }
  153.  
  154. // other stuff
  155.  
  156. char PerlString::chop(void)
  157. {
  158.     int n= length();
  159.     if(n <= 0) return '\0'; // empty
  160.     char tmp= pstr[n-1];
  161.     pstr.remove(n-1);
  162.     return tmp;
  163. }
  164.  
  165. int PerlString::index(const PerlString& s, int offset)
  166. {
  167.     for(int i=offset;i<length();i++){
  168.     if(strncmp(&pstr[i], s, s.length()) == 0) return i;
  169.     }
  170.  
  171.     return -1;
  172. }
  173.  
  174. int PerlString::rindex(const PerlString& s, int offset)
  175. {
  176.     if(offset == -1) offset= length()-s.length();
  177.     else offset= offset-s.length()+1;
  178.     if(offset > length()-s.length()) offset= length()-s.length();
  179.       
  180.     for(int i=offset;i>=0;i--){
  181.     if(strncmp(&pstr[i], s, s.length()) == 0) return i;
  182.     }
  183.     return -1;
  184. }
  185.  
  186. PerlString::substring PerlString::substr(int offset, int len)
  187. {
  188.     if(len == -1) len= length() - offset; // default use rest of string
  189.     if(offset < 0){
  190.     offset= length() + offset;  // count from end of string
  191.     if(offset < 0) offset= 0;   // went too far, adjust to start
  192.     }
  193.     return substring(*this, offset, len);
  194. }
  195.  
  196. // this is private
  197. // it shrinks or expands string as required
  198. void PerlString::insert(int pos, int len, const char *s, int nlen)
  199. {
  200.     if(pos < length()){ // nothing to delete if not true
  201.     if((len+pos) > length()) len= length() - pos;
  202.     pstr.remove(pos, len);  // first remove subrange
  203.     }else pos= length();
  204.  
  205.     VarString tmp(s, nlen);
  206.     pstr.add(pos, tmp);        // then insert new substring
  207. }
  208.  
  209. int PerlString::m(Regexp& r)
  210. {
  211.     return r.match(*this);
  212. }
  213.  
  214. int PerlString::m(const char *pat, const char *opts)
  215. {
  216. int iflg= strchr(opts, 'i') != NULL;
  217.     Regexp r(pat, iflg?Regexp::nocase:0);
  218.     return m(r);
  219. }
  220.  
  221. int PerlString::m(Regexp& r, PerlStringList& psl)
  222. {
  223.     if(!r.match(*this)) return 0;
  224.     psl.reset();    // clear it first
  225.     Range rng;
  226.     for (int i=0; i<r.groups(); i++){
  227.         rng= r.getgroup(i);
  228.     psl.push(substr(rng.start(), rng.length()));
  229.     }
  230.     return r.groups();
  231. }
  232.  
  233. int PerlString::m(const char *pat, PerlStringList& psl, const char *opts)
  234. {
  235. int iflg= strchr(opts, 'i') != NULL;
  236.     Regexp r(pat, iflg?Regexp::nocase:0);
  237.     return m(r, psl);
  238. }
  239.  
  240. //
  241. // I know! This is not fast, but it works!!
  242. //
  243. int PerlString::tr(const char *sl, const char *rl, const char *opts)
  244. {
  245.     if(length() == 0 || strlen(sl) == 0) return 0;
  246.  
  247.     int cflg= strchr(opts, 'c') != NULL; // thanks Michael
  248.     int dflg= strchr(opts, 'd') != NULL;
  249.     int sflg= strchr(opts, 's') != NULL;
  250.  
  251.     int cnt= 0, flen= 0;
  252.     PerlString t;
  253.     unsigned char lstc= '\0', fr[256];
  254.     
  255.     // build search array, which is a 256 byte array that stores the index+1
  256.     // in the search string for each character found, == 0 if not in search
  257.     memset(fr, 0, 256);
  258.     for(int i=0;i<strlen(sl);i++){
  259.     if(i && sl[i] == '-'){ // got a range
  260.         assert(i+1 < strlen(sl) && lstc <= sl[i+1]); // sanity check
  261.         for(unsigned char c=lstc+1;c<=sl[i+1];c++){
  262.         fr[c]= ++flen;
  263.         }
  264.         i++; lstc= '\0';
  265.     }else{
  266.         lstc= sl[i];
  267.         fr[sl[i]]= ++flen;
  268.     }
  269.     }
  270.  
  271.     int rlen;
  272.     // build replacement list
  273.     if((rlen=strlen(rl)) != 0){
  274.     for(i=0;i<rlen;i++){
  275.         if(i && rl[i] == '-'){ // got a range
  276.         assert(i+1 < rlen && t[t.length()-1] <= rl[i+1]); // sanity check
  277.         for(char c=t[i-1]+1;c<=rl[i+1];c++) t += c;
  278.         i++;
  279.         }else t += rl[i];
  280.     }
  281.     }
  282.  
  283.     // replacement string that is shorter uses last character for rest of string
  284.     // unless the delete option is in effect or it is empty
  285.     while(!dflg && rlen && flen > t.length()){
  286.     t += t[t.length()-1]; // duplicate last character
  287.     }
  288.  
  289.     rlen= t.length(); // length of translation string   
  290.    
  291.     // do translation, and deletion if dflg (actually falls out of length of t)
  292.     // also squeeze translated characters if sflg
  293.  
  294.     PerlString tmp; // need this in case dflg, and string changes size
  295.     for(i=0;i<length();i++){
  296.     int off;
  297.     if(cflg){ // complement, ie if NOT in f
  298.         char rc= !dflg ? t[t.length()-1] : '\0'; // always use last character for replacement
  299.         if((off=fr[(*this)[i]]) == 0){ // not in map
  300.         cnt++;
  301.         if(!dflg && (!sflg || tmp.length() == 0 || tmp[tmp.length()-1] != rc))
  302.             tmp += rc;
  303.         }else tmp += (*this)[i]; // just stays the same
  304.     }else{ // in fr so substitute with t, if no equiv in t then delete
  305.         if((off=fr[(*this)[i]]) > 0){
  306.         off--; cnt++;
  307.         if(rlen==0 && !dflg && (!sflg || tmp.length() == 0 || tmp[tmp.length()-1] != (*this)[i])) tmp += (*this)[i]; // stays the same
  308.         else if(off < rlen && (!sflg || tmp.length() == 0 || tmp[tmp.length()-1] != t[off]))
  309.             tmp += t[off]; // substitute
  310.         }else tmp += (*this)[i]; // just stays the same
  311.     }
  312.     }
  313.  
  314.     *this= tmp;
  315.     return cnt;
  316. }
  317.  
  318. int PerlString::s(const char *exp, const char *repl, const char *opts)
  319. {
  320. int gflg= strchr(opts, 'g') != NULL;
  321. int iflg= strchr(opts, 'i') != NULL;
  322. int cnt= 0;
  323. Regexp re(exp, iflg?Regexp::nocase:0);
  324. Range rg;
  325.  
  326.     if(re.match(*this)){
  327.     // OK I know, this is a horrible hack, but it seems to work
  328.     if(gflg){ // recursively call s() until applied to whole string
  329.         rg= re.getgroup(0);
  330.         if(rg.end()+1 < length()){
  331.         PerlString st(substr(rg.end()+1));
  332. //        cout << "Substring: " << st << endl;
  333.         cnt += st.s(exp, repl, opts);
  334.         substr(rg.end()+1)= st;
  335. //        cout << "NewString: " << *this << endl;
  336.         }
  337.     }    
  338.  
  339.     if(!strchr(repl, '$')){ // straight, simple substitution
  340.         rg= re.getgroup(0);
  341.         substr(rg.start(), rg.length())= repl;
  342.         cnt++;    
  343.     }else{ // need to do subexpression substitution
  344.         char c;
  345.         const char *src= repl;
  346.         PerlString dst;
  347.         int no;
  348.         while ((c = *src++) != '\0') {
  349.         if(c == '$' && *src == '&'){
  350.             no = 0; src++;
  351.         }else if(c == '$' && '0' <= *src && *src <= '9')
  352.             no = *src++ - '0';
  353.         else no = -1;
  354.  
  355.         if(no < 0){    /* Ordinary character. */
  356.             if(c == '\\' && (*src == '\\' || *src == '$'))
  357.             c = *src++;
  358.             dst += c;
  359.         }else{
  360.             rg= re.getgroup(no);
  361.             dst += substr(rg.start(), rg.length());
  362.         }
  363.         }
  364.         rg= re.getgroup(0);
  365.         substr(rg.start(), rg.length())= dst;
  366.         cnt++;
  367.     }
  368.  
  369.     return cnt;
  370.     }
  371.     return cnt;
  372. }
  373.  
  374. PerlStringList PerlString::split(const char *pat, int limit)
  375. {
  376. PerlStringList l;
  377.  
  378.     l.split(*this, pat, limit);
  379.     return l;
  380. }
  381.  
  382. //
  383. // PerlStringList stuff
  384. //
  385.  
  386. int PerlStringList::split(const char *str, const char *pat, int limit)
  387. {
  388. Regexp re(pat);
  389. Range rng;
  390. PerlString s(str);
  391. int cnt= 1;
  392.     
  393.     if(*pat == '\0'){ // special empty string case splits entire thing
  394.     while(*str){
  395.         s= *str++;
  396.         push(s);
  397.     }
  398.     return count();
  399.     }
  400.  
  401.     if(strcmp(pat, "' '") == 0){ // special awk case
  402.     char *p, *ws= " \t\n";
  403.     TempString t(str); // can't hack users data
  404.     p= strtok(t, ws);
  405.     while(p){
  406.         push(p);
  407.         p= strtok(NULL, ws);
  408.     }
  409.     return count();
  410.     }
  411.  
  412.     while(re.match(s) && (limit < 0 || cnt < limit)){ // find separator
  413.     rng= re.getgroup(0); // full matched string (entire separator)
  414.     push(s.substr(0, rng.start()));
  415.     for(int i=1;i<re.groups();i++){
  416.         push(s.substr(re.getgroup(i))); // add subexpression matches
  417.     }
  418.     
  419.     s= s.substr(rng.end()+1);
  420.     cnt++;
  421.     }
  422.     if(s.length()) push(s);
  423.  
  424.     if(limit < 0){ // strip trailing null entries
  425.     int off= count()-1;
  426.     while(off >= 0 && (*this)[off].length() == 0){
  427.         off--;
  428.     }
  429.     splice(off+1);
  430.     }
  431.     return count();
  432. }
  433.  
  434. PerlString PerlStringList::join(const char *pat)
  435. {
  436. PerlString ts;
  437.  
  438.     for(int i=0;i<count();i++){
  439.     ts += (*this)[i];
  440.     if(i<count()-1) ts += pat;
  441.     }
  442.     return ts;
  443. }
  444.  
  445.  
  446. PerlStringList::PerlStringList(const PerlStringList& n)
  447. {
  448.     for(int i=0;i<n.count();i++){
  449.     push(n[i]);
  450.     }
  451. }
  452.  
  453. PerlStringList& PerlStringList::operator=(const PerlList<PerlString>& n)
  454. {
  455.     if(this == &n) return *this;
  456.     // erase old one
  457.     reset();
  458.     
  459.     for(int i=0;i<n.count();i++){
  460.     push(n[i]);
  461.     }
  462.     return *this;
  463. }
  464.  
  465. int PerlStringList::m(const char *rege, const char *targ, const char *opts)
  466. {
  467. int iflg= strchr(opts, 'i') != NULL;
  468. Regexp r(rege, iflg?Regexp::nocase:0);
  469.     if(!r.match(targ)) return 0;
  470.     Range rng;
  471.     for (int i=0; i<r.groups(); i++){
  472.         rng= r.getgroup(i);
  473.     push(PerlString(targ).substr(rng.start(), rng.length()));
  474.     }
  475.     return r.groups();
  476. }
  477.  
  478. PerlStringList PerlStringList::grep(const char *rege, const char *opts)
  479. {
  480. PerlStringList rt;
  481. int iflg= strchr(opts, 'i') != NULL;
  482.  
  483.     Regexp rexp(rege, iflg?Regexp::nocase:0);    // compile once
  484.     for(int i=0;i<count();i++){
  485.         if(rexp.match((*this)[i])){
  486.         rt.push((*this)[i]);
  487.     }
  488.     }
  489.     return rt;
  490. }
  491.  
  492. // streams stuff
  493. istream& operator>>(istream& ifs, PerlString& s)
  494. {
  495. char c;
  496. #if 0
  497. char buf[40];
  498. #else
  499. char buf[132];
  500. #endif
  501.  
  502.     s= ""; // empty string
  503.     ifs.get(buf, sizeof buf); 
  504.     // This is tricky because a line teminated by end of file that is not terminated
  505.     // with a '\n' first is considered an OK line, but ifs.good() will fail.
  506.     // This will correctly return the last line if it is terminated by eof with the
  507.     // stream still in a non-fail condition, but at eof, so next call will fail as
  508.     // expected
  509.     if(ifs){         // previous operation was ok
  510.         s += buf;     // append buffer to string
  511. //    cout << "<" << buf << ">" << endl;
  512.     // if its a long line continue appending to string
  513.     while(ifs.good() && (c=ifs.get()) != '\n'){
  514. //        cout << "eof1= " << ifs.eof() << endl;
  515.         ifs.putback(c);
  516. //          cout << "eof2= " << ifs.eof() << endl;
  517.         if(ifs.get(buf, sizeof buf)) s += buf; // append to line
  518.     }
  519.     }
  520.     return ifs;    
  521. }
  522.  
  523. istream& operator>>(istream& ifs, PerlStringList& sl)
  524. {
  525. PerlString s;
  526.  
  527.     // Should I reset sl first?
  528.     sl.reset(); // I think so, to be consistent
  529.     
  530.     while(ifs >> s){
  531.     sl.push(s);
  532. //    cout << "<" << s << ">" << endl;
  533.     };
  534.     return ifs;    
  535. }
  536.  
  537. ostream& operator<<(ostream& os,  const PerlString& arr)
  538. {
  539. #ifdef TEST
  540.     os << "(" << arr.length() << ")" << "\"";
  541.     os << (const char *)arr;
  542.     os << "\"";
  543. #else
  544.     os << (const char *)arr;
  545. #endif
  546.     return os;   
  547. }
  548.  
  549. ostream& operator<<(ostream& os,  const PerlStringList& arr)
  550. {
  551.  
  552.     for(int i=0;i<arr.count();i++)
  553. #ifdef TEST
  554.     os << "[" << i << "]" << arr[i] << endl;
  555. #else     
  556.     os << arr[i] << endl; 
  557. #endif     
  558.     return os;   
  559. }
  560.